ETO Development Tools 1/ETO Development Tools 1.iso/Essentials/Developer Essentials Jul 90/Apple II/Programming & Utilities/Apple IIgs APW Intro Prog Src/HP.PAS/WINDOW.PAS.txt

Text File | 1987-09-14 | 8.7 KB | 270 lines

UNIT Window;

{+----------------------------------------------------------------------------+
 |                                                                            |
 |         HodgePodge:  An example Apple IIGS Desktop application             |
 |                                                                            |
 |    Written in 65816 assembler and APW C by the Apple IIGS Tools Team       |
 |              Translated to TML Pascal by TML Systems, Inc.                 |
 |  Modified by Ben Koning for "Programmer's Introduction to the Apple IIGS"  |
 |                                                                            |
 |             Copyright (c) 1986-87 by Apple Computer, Inc.                  |
 |                Copyright (c) 1987 by TML Systems, Inc.                     |
 |                                                                            |
 |                     --------------------------------                       |
 |                                                                            |
 |     Pascal UNIT "WINDOW.PAS" : Routines to open and close windows          |
 |                                                                            |
 +----------------------------------------------------------------------------+}



INTERFACE

USES
       HPIntfData,         {HodgePodge Apple IIGS Toolbox Interface Units}
       HPIntfProc,
       HPIntfPdos,

       Globals,            {HodgePodge Code Units}
       Dialog,
       Paint,
       Font;



procedure DoCloseItem;             {Closes current frontmost window          }
procedure HideAllWindows;          {Closes all windows on the desktop        }
function  OpenWindow : boolean;    {Tries to open a font or picture window   }
procedure SetUpWindows;            {Initialize variables for stacking windows}





IMPLEMENTATION



VAR
       myWind      :   ParamList;
       Wxoffset    :   integer;
       Wyoffset    :   integer;
       ISizPos     :   Rect;



procedure AdjWind (theWindow: GrafPortPtr);

   {Finds the window designated by theWindow and removes it from the
    WindowList and returns the position in the window list where it was
    found.  Private function.}

   var  i      : integer;
        theOne : integer;

   begin   {of AdjWind}

       {Find the index of the grafportptr of the window being deleted:}
       i := firstWind;
       while WindowList [i] <> theWindow do
           Inc (i);
       theOne  := i;

       {Remove corresponding item from the WINDOW-menu:}
       if WIndex = 1 then begin                {Last window--special case}
           InsertMItem (@NoWindStr [1],FirstWindItem + theOne,WindowsMenuID);
           SetMenuFlag ($0080,WindowsMenuID);
           DrawMenuBar;
           Wxoffset := 20;
           Wyoffset := 12;
       end;
       DeleteMItem   (FirstWindItem + theOne);
       CalcMenuSize  (0,0,WindowsMenuID);

       {Physically delete (scroll) the grafportptr of the ill-fated window:}
       Inc (i);
       while i < LastWind do begin
           WindowList [i - 1] := WindowList [i];
           Inc (i);
       end;

       {Renumber the WINDOW-menu items:}
       for i := theOne to LastWind do
           SetMItemID (FirstWindItem+i-1 {new ID}  ,  FirstWindItem+i {old ID});

   end;    {of AdjWind}



function DoTheOpen: boolean;

   {This function tries to open a window and returns true/false depending on
    its success.}

   var theWindow    : GrafPortPtr;
       myDataHandle : WindDataH;
       theMenuStr   : Str255;

   begin   {of DoTheOpen}
       DoTheOpen := false;

       myDataHandle := WindDataH (NewHandle (sizeof (WindDataRec),
                                             MyMemoryID,
                                             attrLocked + attrFixed,
                                             Ptr (0)));
       if isToolError then
           Exit;

       with myWind do begin
           paramLength  := sizeof (ParamList);
           wFrameBits   := $DDA0;
           wRefCon      := longint (myDataHandle);
           SetRect      (wZoom,0,26,620,190);
           wColor       := nil;
           wYOrigin     := 0;
           wXOrigin     := 0;
           wDataH       := 200;
           wDataW       := 640;
           wMaxH        := 200;
           wMaxW        := 640;
           wScrollVer   := 4;
           wScrollHor   := 16;
           wPageVer     := 40;
           wPageHor     := 160;
           wInfoRefCon  := 0;
           wInfoHeight  := 0;
           wFrameDefProc:= nil;
           wInfoDefProc := nil;
           wPlane       := -1;
           wStorage     := nil;
       end;

       theMenuStr := concat ('==',
                             myReply.filename,
                             '\N',
                             IntToString (FirstWindItem + WIndex),
                             '\0.');

       with myDataHandle^^ do begin
           Name    := myReply.filename;
           MenuStr := theMenuStr;
           MenuID  := FirstWindItem + WIndex;
       end;

       if LoWord (Event.wmTaskData) = FontItem then begin
           {We're opening a font window:}
           myWind.wContDefProc := @DispFontWindow;
           with myDataHandle^^ do begin
               flag    := 1;
               theFont := DesiredFont;
               isMono  := isMonoFont;
           end;
           InstallFont (DesiredFont,0);
       end else begin
           {We're opening a picture window:}
           myWind.wContDefProc := @Paint;
           with myDataHandle^^ do begin
               flag := 0;
               pict := PictHndl;
           end;
       end;

       with myWind do begin
           wTitle := @myDataHandle^^.Name;
           SetRect (wPosition,Wxoffset + ISizPos.h1,
                              Wyoffset + ISizPos.v1,
                              Wxoffset + ISizPos.h2,
                              Wyoffset + ISizPos.v2);
       end;

       Wxoffset := Wxoffset + 20;  {Update globals which offset new window pos}
       Wyoffset := Wyoffset + 12;
       if Wyoffset > 120 then      {Cause stacking effect}
       Wyoffset := 12;

       {Now create the window:}
       theWindow := NewWindow      (myWind);
       SetPort                     (theWindow);
       SetOriginMask               ($FFFE,theWindow);

       InitCursor;                 {Go back to the arrow cursor}
       DoTheOpen := true;          {Indicate successful completion}
   end;    {of DoTheOpen}



procedure DoCloseItem;

   {This procedure closes the frontmost window and deallocates all of its
    associated storage.  NDA windows are supported for when this procedure
    is called by HideAllWindows when exitting HodgePodge.}

   var theWindow    : GrafPortPtr;
       myDataHandle : WindDataH;

   begin   {of DoCloseItem}
       theWindow := FrontWindow;
       CloseNDAbyWinPtr (theWindow);
       if isToolError then begin                   {It wasn't an NDA window}
           AdjWind       (theWindow);              {Update WINDOW menu}
           myDataHandle  := WindDataH (GetWRefCon (theWindow));
           DisposeHandle (Handle (myDataHandle));  {Deallocate storage}
           CloseWindow   (theWindow);              {Remove the window}
           Dec           (WIndex);                 {Index into window list}
       end;
   end;    {of DoCloseItem}



procedure HideAllWindows;

   {Repeatedly call DoCloseItem to close the frontmost window (which has the
    effect of making the next deeper level window the frontmost one) until
    there is no frontmost window anymore; ie, there are no more windows.}

   begin   {of HideAllWindows}
       while FrontWindow <> nil do
           DoCloseItem;
   end;    {of HideAllWindows}



function  OpenWindow : boolean;

   {Tries to open either a font or picture window, depending on the
    Event.TaskData returned from TaskMaster (which got it from the
    Event Manager).  True/false is returned depending on whether a
    window was actually opened.  Note the way in which the different
    functions are called in the if-then-else structure below.  Each
    function tries to do what its name implies, and the true/false
    result that each returns is used to determine if the next logical
    function should be called.}

   begin   {of OpenWindow}
       OpenWindow := false;
       if LoWord (Event.wmTaskData) = FontItem then begin
           if DoChooseFont then
               if DoTheOpen then
                   OpenWindow := true
       end else begin
           if AskUser then
               if DoTheOpen then
                   OpenWindow := true
       end;
   end;    {of OpenWindow}



procedure SetUpWindows;

   begin   {of SetUpWindows}
       Wxoffset := 20;                 {Initial window position offset used for}
       Wyoffset := 12;                 {...stacking the windows.}
       SetRect  (ISizPos,10,20,350,80);
   end;    {of SetUpWindows}



END.